home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / dejagnu.lha / dejagnu-1.0.1 / tcl / tclHistory.c < prev    next >
C/C++ Source or Header  |  1993-02-13  |  30KB  |  1,093 lines

  1. /* 
  2.  * tclHistory.c --
  3.  *
  4.  *    This module implements history as an optional addition to Tcl.
  5.  *    It can be called to record commands ("events") before they are
  6.  *    executed, and it provides a command that may be used to perform
  7.  *    history substitutions.
  8.  *
  9.  * Copyright 1990-1991 Regents of the University of California
  10.  * Permission to use, copy, modify, and distribute this
  11.  * software and its documentation for any purpose and without
  12.  * fee is hereby granted, provided that the above copyright
  13.  * notice appear in all copies.  The University of California
  14.  * makes no representations about the suitability of this
  15.  * software for any purpose.  It is provided "as is" without
  16.  * express or implied warranty.
  17.  */
  18.  
  19. #include "tclInt.h"
  20.  
  21. /*
  22.  * This history stuff is mostly straightforward, except for one thing
  23.  * that makes everything very complicated.  Suppose that the following
  24.  * commands get executed:
  25.  *    echo foo
  26.  *    history redo
  27.  * It's important that the history event recorded for the second command
  28.  * be "echo foo", not "history redo".  Otherwise, if another "history redo"
  29.  * command is typed, it will result in infinite recursions on the
  30.  * "history redo" command.  Thus, the actual recorded history must be
  31.  *    echo foo
  32.  *    echo foo
  33.  * To do this, the history command revises recorded history as part of
  34.  * its execution.  In the example above, when "history redo" starts
  35.  * execution, the current event is "history redo", but the history
  36.  * command arranges for the current event to be changed to "echo foo".
  37.  *
  38.  * There are three additional complications.  The first is that history
  39.  * substitution may only be part of a command, as in the following
  40.  * command sequence:
  41.  *    echo foo bar
  42.  *    echo [history word 3]
  43.  * In this case, the second event should be recorded as "echo bar".  Only
  44.  * part of the recorded event is to be modified.  Fortunately, Tcl_Eval
  45.  * helps with this by recording (in the evalFirst and evalLast fields of
  46.  * the intepreter) the location of the command being executed, so the
  47.  * history module can replace exactly the range of bytes corresponding
  48.  * to the history substitution command.
  49.  *
  50.  * The second complication is that there are two ways to revise history:
  51.  * replace a command, and replace the result of a command.  Consider the
  52.  * two examples below:
  53.  *    format {result is %d} $num       |    format {result is %d} $num
  54.  *    print [history redo]           |    print [history word 3]
  55.  * Recorded history for these two cases should be as follows:
  56.  *    format {result is %d} $num       |    format {result is %d} $num
  57.  *    print [format {result is %d} $num] |    print $num
  58.  * In the left case, the history command was replaced with another command
  59.  * to be executed (the brackets were retained), but in the case on the
  60.  * right the result of executing the history command was replaced (i.e.
  61.  * brackets were replaced too).
  62.  *
  63.  * The third complication is that there could potentially be many
  64.  * history substitutions within a single command, as in:
  65.  *    echo [history word 3] [history word 2]
  66.  * There could even be nested history substitutions, as in:
  67.  *    history subs abc [history word 2]
  68.  * If history revisions were made immediately during each "history" command
  69.  * invocations, it would be very difficult to produce the correct cumulative
  70.  * effect from several substitutions in the same command.  To get around
  71.  * this problem, the actual history revision isn't made during the execution
  72.  * of the "history" command.  Information about the changes is just recorded,
  73.  * in xxx records, and the actual changes are made during the next call to
  74.  * Tcl_RecordHistory (when we know that execution of the previous command
  75.  * has finished).
  76.  */
  77.  
  78. /*
  79.  * Default space allocation for command strings:
  80.  */
  81.  
  82. #define INITIAL_CMD_SIZE 40
  83.  
  84. /*
  85.  * Forward declarations for procedures defined later in this file:
  86.  */
  87.  
  88. static void        DoRevs _ANSI_ARGS_((Interp *iPtr));
  89. static HistoryEvent *    GetEvent _ANSI_ARGS_((Interp *iPtr, char *string));
  90. static char *        GetWords _ANSI_ARGS_((Interp *iPtr, char *command,
  91.                 char *words));
  92. static void        InsertRev _ANSI_ARGS_((Interp *iPtr,
  93.                 HistoryRev *revPtr));
  94. static void        MakeSpace _ANSI_ARGS_((HistoryEvent *hPtr, int size));
  95. static void        RevCommand _ANSI_ARGS_((Interp *iPtr, char *string));
  96. static void        RevResult _ANSI_ARGS_((Interp *iPtr, char *string));
  97. static int        SubsAndEval _ANSI_ARGS_((Interp *iPtr, char *cmd,
  98.                 char *old, char *new));
  99.  
  100. /*
  101.  *----------------------------------------------------------------------
  102.  *
  103.  * Tcl_InitHistory --
  104.  *
  105.  *    Initialize history-related state in an interpreter.
  106.  *
  107.  * Results:
  108.  *    None.
  109.  *
  110.  * Side effects:
  111.  *    History info is initialized in iPtr.
  112.  *
  113.  *----------------------------------------------------------------------
  114.  */
  115.  
  116. void
  117. Tcl_InitHistory(interp)
  118.     Tcl_Interp *interp;        /* Interpreter to initialize. */
  119. {
  120.     register Interp *iPtr = (Interp *) interp;
  121.     int i;
  122.  
  123.     if (iPtr->numEvents != 0) {
  124.     return;
  125.     }
  126.     iPtr->numEvents = 20;
  127.     iPtr->events = (HistoryEvent *)
  128.         ckalloc((unsigned) (iPtr->numEvents * sizeof(HistoryEvent)));
  129.     for (i = 0; i < iPtr->numEvents; i++) {
  130.     iPtr->events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE);
  131.     *iPtr->events[i].command = 0;
  132.     iPtr->events[i].bytesAvl = INITIAL_CMD_SIZE;
  133.     }
  134.     iPtr->curEvent = 0;
  135.     iPtr->curEventNum = 0;
  136.     Tcl_CreateCommand((Tcl_Interp *) iPtr, "history", Tcl_HistoryCmd,
  137.         (ClientData) NULL, (void (*)()) NULL);
  138. }
  139.  
  140. /*
  141.  *----------------------------------------------------------------------
  142.  *
  143.  * Tcl_RecordAndEval --
  144.  *
  145.  *    This procedure adds its command argument to the current list of
  146.  *    recorded events and then executes the command by calling Tcl_Eval.
  147.  *
  148.  * Results:
  149.  *    The return value is a standard Tcl return value, the result of
  150.  *    executing cmd.
  151.  *
  152.  * Side effects:
  153.  *    The command is recorded and executed.  In addition, pending history
  154.  *    revisions are carried out, and information is set up to enable
  155.  *    Tcl_Eval to identify history command ranges.  This procedure also
  156.  *    initializes history information for the interpreter, if it hasn't
  157.  *    already been initialized.
  158.  *
  159.  *----------------------------------------------------------------------
  160.  */
  161.  
  162. int
  163. Tcl_RecordAndEval(interp, cmd, flags)
  164.     Tcl_Interp *interp;        /* Token for interpreter in which command
  165.                  * will be executed. */
  166.     char *cmd;            /* Command to record. */
  167.     int flags;            /* Additional flags to pass to Tcl_Eval. 
  168.                  * TCL_NO_EVAL means only record: don't
  169.                  * execute command. */
  170. {
  171.     register Interp *iPtr = (Interp *) interp;
  172.     register HistoryEvent *eventPtr;
  173.     int length, result;
  174.  
  175.     if (iPtr->numEvents == 0) {
  176.     Tcl_InitHistory(interp);
  177.     }
  178.     DoRevs(iPtr);
  179.  
  180.     /*
  181.      * Don't record empty commands.
  182.      */
  183.  
  184.     while (isspace(*cmd)) {
  185.     cmd++;
  186.     }
  187.     if (*cmd == '\0') {
  188.     Tcl_ResetResult(interp);
  189.     return TCL_OK;
  190.     }
  191.  
  192.     iPtr->curEventNum++;
  193.     iPtr->curEvent++;
  194.     if (iPtr->curEvent >= iPtr->numEvents) {
  195.     iPtr->curEvent = 0;
  196.     }
  197.     eventPtr = &iPtr->events[iPtr->curEvent];
  198.  
  199.     /*
  200.      * Chop off trailing newlines before recording the command.
  201.      */
  202.  
  203.     length = strlen(cmd);
  204.     while (cmd[length-1] == '\n') {
  205.     length--;
  206.     }
  207.     MakeSpace(eventPtr, length + 1);
  208.     strncpy(eventPtr->command, cmd, length);
  209.     eventPtr->command[length] = 0;
  210.  
  211.     /*
  212.      * Execute the command.  Note: history revision isn't possible after
  213.      * a nested call to this procedure, because the event at the top of
  214.      * the history list no longer corresponds to what's going on when
  215.      * a nested call here returns.  Thus, must leave history revision
  216.      * disabled when we return.
  217.      */
  218.  
  219.     result = TCL_OK;
  220.     if (flags != TCL_NO_EVAL) {
  221.     iPtr->historyFirst = cmd;
  222.     iPtr->revDisables = 0;
  223.     result = Tcl_Eval(interp, cmd, flags | TCL_RECORD_BOUNDS,
  224.         (char **) NULL);
  225.     }
  226.     iPtr->revDisables = 1;
  227.     return result;
  228. }
  229.  
  230. /*
  231.  *----------------------------------------------------------------------
  232.  *
  233.  * Tcl_HistoryCmd --
  234.  *
  235.  *    This procedure is invoked to process the "history" Tcl command.
  236.  *    See the user documentation for details on what it does.
  237.  *
  238.  * Results:
  239.  *    A standard Tcl result.
  240.  *
  241.  * Side effects:
  242.  *    See the user documentation.
  243.  *
  244.  *----------------------------------------------------------------------
  245.  */
  246.  
  247.     /* ARGSUSED */
  248. int
  249. Tcl_HistoryCmd(dummy, interp, argc, argv)
  250.     ClientData dummy;            /* Not used. */
  251.     Tcl_Interp *interp;            /* Current interpreter. */
  252.     int argc;                /* Number of arguments. */
  253.     char **argv;            /* Argument strings. */
  254. {
  255.     register Interp *iPtr = (Interp *) interp;
  256.     register HistoryEvent *eventPtr;
  257.     int length;
  258.     char c;
  259.  
  260.     /*
  261.      * If no arguments, treat the same as "history info".
  262.      */
  263.  
  264.     if (argc == 1) {
  265.     goto infoCmd;
  266.     }
  267.  
  268.     c = argv[1][0];
  269.     length = strlen(argv[1]);
  270.  
  271.     if ((c == 'a') && (strncmp(argv[1], "add", length)) == 0) {
  272.     if ((argc != 3) && (argc != 4)) {
  273.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  274.             " add event ?exec?\"", (char *) NULL);
  275.         return TCL_ERROR;
  276.     }
  277.     if (argc == 4) {
  278.         if (strncmp(argv[3], "exec", strlen(argv[3])) != 0) {
  279.         Tcl_AppendResult(interp, "bad argument \"", argv[3],
  280.             "\": should be \"exec\"", (char *) NULL);
  281.         return TCL_ERROR;
  282.         }
  283.         return Tcl_RecordAndEval(interp, argv[2], 0);
  284.     }
  285.     return Tcl_RecordAndEval(interp, argv[2], TCL_NO_EVAL);
  286.     } else if ((c == 'c') && (strncmp(argv[1], "change", length)) == 0) {
  287.     if ((argc != 3) && (argc != 4)) {
  288.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  289.             " change newValue ?event?\"", (char *) NULL);
  290.         return TCL_ERROR;
  291.     }
  292.     if (argc == 3) {
  293.         eventPtr = &iPtr->events[iPtr->curEvent];
  294.         iPtr->revDisables += 1;
  295.         while (iPtr->revPtr != NULL) {
  296.         HistoryRev *nextPtr;
  297.  
  298.         ckfree(iPtr->revPtr->newBytes);
  299.         nextPtr = iPtr->revPtr->nextPtr;
  300.         ckfree((char *) iPtr->revPtr);
  301.         iPtr->revPtr = nextPtr;
  302.         }
  303.     } else {
  304.         eventPtr = GetEvent(iPtr, argv[3]);
  305.         if (eventPtr == NULL) {
  306.         return TCL_ERROR;
  307.         }
  308.     }
  309.     MakeSpace(eventPtr, strlen(argv[2]) + 1);
  310.     strcpy(eventPtr->command, argv[2]);
  311.     return TCL_OK;
  312.     } else if ((c == 'e') && (strncmp(argv[1], "event", length)) == 0) {
  313.     if (argc > 3) {
  314.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  315.             " event ?event?\"", (char *) NULL);
  316.         return TCL_ERROR;
  317.     }
  318.     eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]);
  319.     if (eventPtr == NULL) {
  320.         return TCL_ERROR;
  321.     }
  322.     RevResult(iPtr, eventPtr->command);
  323.     Tcl_SetResult(interp, eventPtr->command, TCL_VOLATILE);
  324.     return TCL_OK;
  325.     } else if ((c == 'i') && (strncmp(argv[1], "info", length)) == 0) {
  326.     int count, indx, i;
  327.     char *newline;
  328.  
  329.     if ((argc != 2) && (argc != 3)) {
  330.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  331.             " info ?count?\"", (char *) NULL);
  332.         return TCL_ERROR;
  333.     }
  334.     infoCmd:
  335.     if (argc == 3) {
  336.         if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
  337.         return TCL_ERROR;
  338.         }
  339.         if (count > iPtr->numEvents) {
  340.         count = iPtr->numEvents;
  341.         }
  342.     } else {
  343.         count = iPtr->numEvents;
  344.     }
  345.     newline = "";
  346.     for (i = 0, indx = iPtr->curEvent + 1 + iPtr->numEvents - count;
  347.         i < count; i++, indx++) {
  348.         char *cur, *next, savedChar;
  349.         char serial[20];
  350.  
  351.         if (indx >= iPtr->numEvents) {
  352.         indx -= iPtr->numEvents;
  353.         }
  354.         cur = iPtr->events[indx].command;
  355.         if (*cur == '\0') {
  356.         continue;        /* No command recorded here. */
  357.         }
  358.         sprintf(serial, "%6d  ", iPtr->curEventNum + 1 - (count - i));
  359.         Tcl_AppendResult(interp, newline, serial, (char *) NULL);
  360.         newline = "\n";
  361.  
  362.         /*
  363.          * Tricky formatting here:  for multi-line commands, indent
  364.          * the continuation lines.
  365.          */
  366.  
  367.         while (1) {
  368.         next = strchr(cur, '\n');
  369.         if (next == NULL) {
  370.             break;
  371.         }
  372.         next++;
  373.         savedChar = *next;
  374.         *next = 0;
  375.         Tcl_AppendResult(interp, cur, "\t", (char *) NULL);
  376.         *next = savedChar;
  377.         cur = next;
  378.         }
  379.         Tcl_AppendResult(interp, cur, (char *) NULL);
  380.     }
  381.     return TCL_OK;
  382.     } else if ((c == 'k') && (strncmp(argv[1], "keep", length)) == 0) {
  383.     int count, i, src;
  384.     HistoryEvent *events;
  385.  
  386.     if (argc != 3) {
  387.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  388.             " keep number\"", (char *) NULL);
  389.         return TCL_ERROR;
  390.     }
  391.     if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
  392.         return TCL_ERROR;
  393.     }
  394.     if ((count <= 0) || (count > 1000)) {
  395.         Tcl_AppendResult(interp, "illegal keep count \"", argv[2],
  396.             "\"", (char *) NULL);
  397.         return TCL_ERROR;
  398.     }
  399.  
  400.     /*
  401.      * Create a new history array and copy as much existing history
  402.      * as possible from the old array.
  403.      */
  404.  
  405.     events = (HistoryEvent *)
  406.         ckalloc((unsigned) (count * sizeof(HistoryEvent)));
  407.     if (count < iPtr->numEvents) {
  408.         src = iPtr->curEvent + 1 - count;
  409.         if (src < 0) {
  410.         src += iPtr->numEvents;
  411.         }
  412.     } else {
  413.         src = iPtr->curEvent + 1;
  414.     }
  415.     for (i = 0; i < count; i++, src++) {
  416.         if (src >= iPtr->numEvents) {
  417.         src = 0;
  418.         }
  419.         if (i < iPtr->numEvents) {
  420.         events[i] = iPtr->events[src];
  421.         iPtr->events[src].command = NULL;
  422.         } else {
  423.         events[i].command = (char *) ckalloc(INITIAL_CMD_SIZE);
  424.         events[i].command[0] = 0;
  425.         events[i].bytesAvl = INITIAL_CMD_SIZE;
  426.         }
  427.     }
  428.  
  429.     /*
  430.      * Throw away everything left in the old history array, and
  431.      * substitute the new one for the old one.
  432.      */
  433.  
  434.     for (i = 0; i < iPtr->numEvents; i++) {
  435.         if (iPtr->events[i].command != NULL) {
  436.         ckfree(iPtr->events[i].command);
  437.         }
  438.     }
  439.     ckfree((char *) iPtr->events);
  440.     iPtr->events = events;
  441.     if (count < iPtr->numEvents) {
  442.         iPtr->curEvent = count-1;
  443.     } else {
  444.         iPtr->curEvent = iPtr->numEvents-1;
  445.     }
  446.     iPtr->numEvents = count;
  447.     return TCL_OK;
  448.     } else if ((c == 'n') && (strncmp(argv[1], "nextid", length)) == 0) {
  449.     if (argc != 2) {
  450.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  451.             " nextid\"", (char *) NULL);
  452.         return TCL_ERROR;
  453.     }
  454.     sprintf(iPtr->result, "%d", iPtr->curEventNum+1);
  455.     return TCL_OK;
  456.     } else if ((c == 'r') && (strncmp(argv[1], "redo", length)) == 0) {
  457.     if (argc > 3) {
  458.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  459.             " redo ?event?\"", (char *) NULL);
  460.         return TCL_ERROR;
  461.     }
  462.     eventPtr = GetEvent(iPtr, argc==2 ? "-1" : argv[2]);
  463.     if (eventPtr == NULL) {
  464.         return TCL_ERROR;
  465.     }
  466.     RevCommand(iPtr, eventPtr->command);
  467.     return Tcl_Eval(interp, eventPtr->command, 0, (char **) NULL);
  468.     } else if ((c == 's') && (strncmp(argv[1], "substitute", length)) == 0) {
  469.     if ((argc > 5) || (argc < 4)) {
  470.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  471.             " substitute old new ?event?\"", (char *) NULL);
  472.         return TCL_ERROR;
  473.     }
  474.     eventPtr = GetEvent(iPtr, argc==4 ? "-1" : argv[4]);
  475.     if (eventPtr == NULL) {
  476.         return TCL_ERROR;
  477.     }
  478.     return SubsAndEval(iPtr, eventPtr->command, argv[2], argv[3]);
  479.     } else if ((c == 'w') && (strncmp(argv[1], "words", length)) == 0) {
  480.     char *words;
  481.  
  482.     if ((argc != 3) && (argc != 4)) {
  483.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  484.             " words num-num/pat ?event?\"", (char *) NULL);
  485.         return TCL_ERROR;
  486.     }
  487.     eventPtr = GetEvent(iPtr, argc==3 ? "-1" : argv[3]);
  488.     if (eventPtr == NULL) {
  489.         return TCL_ERROR;
  490.     }
  491.     words = GetWords(iPtr, eventPtr->command, argv[2]);
  492.     if (words == NULL) {
  493.         return TCL_ERROR;
  494.     }
  495.     RevResult(iPtr, words);
  496.     iPtr->result = words;
  497.     iPtr->freeProc = (Tcl_FreeProc *) free;
  498.     return TCL_OK;
  499.     }
  500.  
  501.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  502.         "\": must be add, change, event, info, keep, nextid, ",
  503.         "redo, substitute, or words", (char *) NULL);
  504.     return TCL_ERROR;
  505. }
  506.  
  507. /*
  508.  *----------------------------------------------------------------------
  509.  *
  510.  * MakeSpace --
  511.  *
  512.  *    Given a history event, make sure it has enough space for
  513.  *    a string of a given length (enlarge the string area if
  514.  *    necessary).
  515.  *
  516.  * Results:
  517.  *    None.
  518.  *
  519.  * Side effects:
  520.  *    More memory may get allocated.
  521.  *
  522.  *----------------------------------------------------------------------
  523.  */
  524.  
  525. static void
  526. MakeSpace(hPtr, size)
  527.     HistoryEvent *hPtr;
  528.     int size;            /* # of bytes needed in hPtr. */
  529. {
  530.     if (hPtr->bytesAvl < size) {
  531.     ckfree(hPtr->command);
  532.     hPtr->command = (char *) ckalloc((unsigned) size);
  533.     hPtr->bytesAvl = size;
  534.     }
  535. }
  536.  
  537. /*
  538.  *----------------------------------------------------------------------
  539.  *
  540.  * InsertRev --
  541.  *
  542.  *    Add a new revision to the list of those pending for iPtr.
  543.  *    Do it in a way that keeps the revision list sorted in
  544.  *    increasing order of firstIndex.  Also, eliminate revisions
  545.  *    that are subsets of other revisions.
  546.  *
  547.  * Results:
  548.  *    None.
  549.  *
  550.  * Side effects:
  551.  *    RevPtr is added to iPtr's revision list.
  552.  *
  553.  *----------------------------------------------------------------------
  554.  */
  555.  
  556. static void
  557. InsertRev(iPtr, revPtr)
  558.     Interp *iPtr;            /* Interpreter to use. */
  559.     register HistoryRev *revPtr;    /* Revision to add to iPtr's list. */
  560. {
  561.     register HistoryRev *curPtr;
  562.     register HistoryRev *prevPtr;
  563.  
  564.     for (curPtr = iPtr->revPtr, prevPtr = NULL; curPtr != NULL;
  565.         prevPtr = curPtr, curPtr = curPtr->nextPtr) {
  566.     /*
  567.      * If this revision includes the new one (or vice versa) then
  568.      * just eliminate the one that is a subset of the other.
  569.      */
  570.  
  571.     if ((revPtr->firstIndex <= curPtr->firstIndex)
  572.         && (revPtr->lastIndex >= curPtr->firstIndex)) {
  573.         curPtr->firstIndex = revPtr->firstIndex;
  574.         curPtr->lastIndex = revPtr->lastIndex;
  575.         curPtr->newSize = revPtr->newSize;
  576.         ckfree(curPtr->newBytes);
  577.         curPtr->newBytes = revPtr->newBytes;
  578.         ckfree((char *) revPtr);
  579.         return;
  580.     }
  581.     if ((revPtr->firstIndex >= curPtr->firstIndex)
  582.         && (revPtr->lastIndex <= curPtr->lastIndex)) {
  583.         ckfree(revPtr->newBytes);
  584.         ckfree((char *) revPtr);
  585.         return;
  586.     }
  587.  
  588.     if (revPtr->firstIndex < curPtr->firstIndex) {
  589.         break;
  590.     }
  591.     }
  592.  
  593.     /*
  594.      * Insert revPtr just after prevPtr.
  595.      */
  596.  
  597.     if (prevPtr == NULL) {
  598.     revPtr->nextPtr = iPtr->revPtr;
  599.     iPtr->revPtr = revPtr;
  600.     } else {
  601.     revPtr->nextPtr = prevPtr->nextPtr;
  602.     prevPtr->nextPtr = revPtr;
  603.     }
  604. }
  605.  
  606. /*
  607.  *----------------------------------------------------------------------
  608.  *
  609.  * RevCommand --
  610.  *
  611.  *    This procedure is invoked by the "history" command to record
  612.  *    a command revision.  See the comments at the beginning of the
  613.  *    file for more information about revisions.
  614.  *
  615.  * Results:
  616.  *    None.
  617.  *
  618.  * Side effects:
  619.  *    Revision information is recorded.
  620.  *
  621.  *----------------------------------------------------------------------
  622.  */
  623.  
  624. static void
  625. RevCommand(iPtr, string)
  626.     register Interp *iPtr;    /* Interpreter in which to perform the
  627.                  * substitution. */
  628.     char *string;        /* String to substitute. */
  629. {
  630.     register HistoryRev *revPtr;
  631.  
  632.     if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) {
  633.     return;
  634.     }
  635.     revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev));
  636.     revPtr->firstIndex = iPtr->evalFirst - iPtr->historyFirst;
  637.     revPtr->lastIndex = iPtr->evalLast - iPtr->historyFirst;
  638.     revPtr->newSize = strlen(string);
  639.     revPtr->newBytes = (char *) ckalloc((unsigned) (revPtr->newSize+1));
  640.     strcpy(revPtr->newBytes, string);
  641.     InsertRev(iPtr, revPtr);
  642. }
  643.  
  644. /*
  645.  *----------------------------------------------------------------------
  646.  *
  647.  * RevResult --
  648.  *
  649.  *    This procedure is invoked by the "history" command to record
  650.  *    a result revision.  See the comments at the beginning of the
  651.  *    file for more information about revisions.
  652.  *
  653.  * Results:
  654.  *    None.
  655.  *
  656.  * Side effects:
  657.  *    Revision information is recorded.
  658.  *
  659.  *----------------------------------------------------------------------
  660.  */
  661.  
  662. static void
  663. RevResult(iPtr, string)
  664.     register Interp *iPtr;    /* Interpreter in which to perform the
  665.                  * substitution. */
  666.     char *string;        /* String to substitute. */
  667. {
  668.     register HistoryRev *revPtr;
  669.     char *evalFirst, *evalLast;
  670.     char *argv[2];
  671.  
  672.     if ((iPtr->evalFirst == NULL) || (iPtr->revDisables > 0)) {
  673.     return;
  674.     }
  675.  
  676.     /*
  677.      * Expand the replacement range to include the brackets that surround
  678.      * the command.  If there aren't any brackets (i.e. this command was
  679.      * invoked at top-level) then don't do any revision.  Also, if there
  680.      * are several commands in brackets, of which this is just one,
  681.      * then don't do any revision.
  682.      */
  683.  
  684.     evalFirst = iPtr->evalFirst;
  685.     evalLast = iPtr->evalLast + 1;
  686.     while (1) {
  687.     if (evalFirst == iPtr->historyFirst) {
  688.         return;
  689.     }
  690.     evalFirst--;
  691.     if (*evalFirst == '[') {
  692.         break;
  693.     }
  694.     if (!isspace(*evalFirst)) {
  695.         return;
  696.     }
  697.     }
  698.     if (*evalLast != ']') {
  699.     return;
  700.     }
  701.  
  702.     revPtr = (HistoryRev *) ckalloc(sizeof(HistoryRev));
  703.     revPtr->firstIndex = evalFirst - iPtr->historyFirst;
  704.     revPtr->lastIndex = evalLast - iPtr->historyFirst;
  705.     argv[0] = string;
  706.     revPtr->newBytes = Tcl_Merge(1, argv);
  707.     revPtr->newSize = strlen(revPtr->newBytes);
  708.     InsertRev(iPtr, revPtr);
  709. }
  710.  
  711. /*
  712.  *----------------------------------------------------------------------
  713.  *
  714.  * DoRevs --
  715.  *
  716.  *    This procedure is called to apply the history revisions that
  717.  *    have been recorded in iPtr.
  718.  *
  719.  * Results:
  720.  *    None.
  721.  *
  722.  * Side effects:
  723.  *    The most recent entry in the history for iPtr may be modified.
  724.  *
  725.  *----------------------------------------------------------------------
  726.  */
  727.  
  728. static void
  729. DoRevs(iPtr)
  730.     register Interp *iPtr;    /* Interpreter whose history is to
  731.                  * be modified. */
  732. {
  733.     register HistoryRev *revPtr;
  734.     register HistoryEvent *eventPtr;
  735.     char *newCommand, *p;
  736.     unsigned int size;
  737.     int bytesSeen, count;
  738.  
  739.     if (iPtr->revPtr == NULL) {
  740.     return;
  741.     }
  742.  
  743.     /*
  744.      * The revision is done in two passes.  The first pass computes the
  745.      * amount of space needed for the revised event, and the second pass
  746.      * pieces together the new event and frees up the revisions.
  747.      */
  748.  
  749.     eventPtr = &iPtr->events[iPtr->curEvent];
  750.     size = strlen(eventPtr->command) + 1;
  751.     for (revPtr = iPtr->revPtr; revPtr != NULL; revPtr = revPtr->nextPtr) {
  752.     size -= revPtr->lastIndex + 1 - revPtr->firstIndex;
  753.     size += revPtr->newSize;
  754.     }
  755.  
  756.     newCommand = (char *) ckalloc(size);
  757.     p = newCommand;
  758.     bytesSeen = 0;
  759.     for (revPtr = iPtr->revPtr; revPtr != NULL; ) {
  760.     HistoryRev *nextPtr = revPtr->nextPtr;
  761.  
  762.     count = revPtr->firstIndex - bytesSeen;
  763.     if (count > 0) {
  764.         strncpy(p, eventPtr->command + bytesSeen, count);
  765.         p += count;
  766.     }
  767.     strncpy(p, revPtr->newBytes, revPtr->newSize);
  768.     p += revPtr->newSize;
  769.     bytesSeen = revPtr->lastIndex+1;
  770.     ckfree(revPtr->newBytes);
  771.     ckfree((char *) revPtr);
  772.     revPtr = nextPtr;
  773.     }
  774.     if (&p[strlen(&eventPtr->command[bytesSeen]) + 1] >
  775.         &newCommand[size]) {
  776.     printf("Assertion failed!\n");
  777.     }
  778.     strcpy(p, eventPtr->command + bytesSeen);
  779.  
  780.     /*
  781.      * Replace the command in the event.
  782.      */
  783.  
  784.     ckfree(eventPtr->command);
  785.     eventPtr->command = newCommand;
  786.     eventPtr->bytesAvl = size;
  787.     iPtr->revPtr = NULL;
  788. }
  789.  
  790. /*
  791.  *----------------------------------------------------------------------
  792.  *
  793.  * GetEvent --
  794.  *
  795.  *    Given a textual description of an event (see the manual page
  796.  *    for legal values) find the corresponding event and return its
  797.  *    command string.
  798.  *
  799.  * Results:
  800.  *    The return value is a pointer to the event named by "string".
  801.  *    If no such event exists, then NULL is returned and an error
  802.  *    message is left in iPtr.
  803.  *
  804.  * Side effects:
  805.  *    None.
  806.  *
  807.  *----------------------------------------------------------------------
  808.  */
  809.  
  810. static HistoryEvent *
  811. GetEvent(iPtr, string)
  812.     register Interp *iPtr;    /* Interpreter in which to look. */
  813.     char *string;        /* Description of event. */
  814. {
  815.     int eventNum, index;
  816.     register HistoryEvent *eventPtr;
  817.     int length;
  818.  
  819.     /*
  820.      * First check for a numeric specification of an event.
  821.      */
  822.  
  823.     if (isdigit(*string) || (*string == '-')) {
  824.     if (Tcl_GetInt((Tcl_Interp *) iPtr, string, &eventNum) != TCL_OK) {
  825.         return NULL;
  826.     }
  827.     if (eventNum < 0) {
  828.         eventNum += iPtr->curEventNum;
  829.         }
  830.     if (eventNum > iPtr->curEventNum) {
  831.         Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string,
  832.             "\" hasn't occurred yet", (char *) NULL);
  833.         return NULL;
  834.     }
  835.     if ((eventNum <= iPtr->curEventNum-iPtr->numEvents)
  836.         || (eventNum <= 0)) {
  837.         Tcl_AppendResult((Tcl_Interp *) iPtr, "event \"", string,
  838.             "\" is too far in the past", (char *) NULL);
  839.         return NULL;
  840.     }
  841.     index = iPtr->curEvent + (eventNum - iPtr->curEventNum);
  842.     if (index < 0) {
  843.         index += iPtr->numEvents;
  844.     }
  845.     return &iPtr->events[index];
  846.     }
  847.  
  848.     /*
  849.      * Next, check for an event that contains the string as a prefix or
  850.      * that matches the string in the sense of Tcl_StringMatch.
  851.      */
  852.  
  853.     length = strlen(string);
  854.     for (index = iPtr->curEvent - 1; ; index--) {
  855.     if (index < 0) {
  856.         index += iPtr->numEvents;
  857.     }
  858.     if (index == iPtr->curEvent) {
  859.         break;
  860.     }
  861.     eventPtr = &iPtr->events[index];
  862.     if ((strncmp(eventPtr->command, string, length) == 0)
  863.         || Tcl_StringMatch(eventPtr->command, string)) {
  864.         return eventPtr;
  865.     }
  866.     }
  867.  
  868.     Tcl_AppendResult((Tcl_Interp *) iPtr, "no event matches \"", string,
  869.         "\"", (char *) NULL);
  870.     return NULL;
  871. }
  872.  
  873. /*
  874.  *----------------------------------------------------------------------
  875.  *
  876.  * SubsAndEval --
  877.  *
  878.  *    Generate a new command by making a textual substitution in
  879.  *    the "cmd" argument.  Then execute the new command.
  880.  *
  881.  * Results:
  882.  *    The return value is a standard Tcl error.
  883.  *
  884.  * Side effects:
  885.  *    History gets revised if the substitution is occurring on
  886.  *    a recorded command line.  Also, the re-executed command
  887.  *    may produce side-effects.
  888.  *
  889.  *----------------------------------------------------------------------
  890.  */
  891.  
  892. static int
  893. SubsAndEval(iPtr, cmd, old, new)
  894.     register Interp *iPtr;    /* Interpreter in which to execute
  895.                  * new command. */
  896.     char *cmd;            /* Command in which to substitute. */
  897.     char *old;            /* String to search for in command. */
  898.     char *new;            /* Replacement string for "old". */
  899. {
  900.     char *src, *dst, *newCmd;
  901.     int count, oldLength, newLength, length, result;
  902.  
  903.     /*
  904.      * Figure out how much space it will take to hold the
  905.      * substituted command (and complain if the old string
  906.      * doesn't appear in the original command).
  907.      */
  908.  
  909.     oldLength = strlen(old);
  910.     newLength = strlen(new);
  911.     src = cmd;
  912.     count = 0;
  913.     while (1) {
  914.     src = strstr(src, old);
  915.     if (src == NULL) {
  916.         break;
  917.     }
  918.     src += oldLength;
  919.     count++;
  920.     }
  921.     if (count == 0) {
  922.     Tcl_AppendResult((Tcl_Interp *) iPtr, "\"", old,
  923.         "\" doesn't appear in event", (char *) NULL);
  924.     return TCL_ERROR;
  925.     }
  926.     length = strlen(cmd) + count*(newLength - oldLength);
  927.  
  928.     /*
  929.      * Generate a substituted command.
  930.      */
  931.  
  932.     newCmd = (char *) ckalloc((unsigned) (length + 1));
  933.     dst = newCmd;
  934.     while (1) {
  935.     src = strstr(cmd, old);
  936.     if (src == NULL) {
  937.         strcpy(dst, cmd);
  938.         break;
  939.     }
  940.     strncpy(dst, cmd, src-cmd);
  941.     dst += src-cmd;
  942.     strcpy(dst, new);
  943.     dst += newLength;
  944.     cmd = src + oldLength;
  945.     }
  946.  
  947.     RevCommand(iPtr, newCmd);
  948.     result = Tcl_Eval((Tcl_Interp *) iPtr, newCmd, 0, (char **) NULL);
  949.     ckfree(newCmd);
  950.     return result;
  951. }
  952.  
  953. /*
  954.  *----------------------------------------------------------------------
  955.  *
  956.  * GetWords --
  957.  *
  958.  *    Given a command string, return one or more words from the
  959.  *    command string.
  960.  *
  961.  * Results:
  962.  *    The return value is a pointer to a dynamically-allocated
  963.  *    string containing the words of command specified by "words".
  964.  *    If the word specifier has improper syntax then an error
  965.  *    message is placed in iPtr->result and NULL is returned.
  966.  *
  967.  * Side effects:
  968.  *    Memory is allocated.  It is the caller's responsibilty to
  969.  *    free the returned string..
  970.  *
  971.  *----------------------------------------------------------------------
  972.  */
  973.  
  974. static char *
  975. GetWords(iPtr, command, words)
  976.     register Interp *iPtr;    /* Tcl interpreter in which to place
  977.                  * an error message if needed. */
  978.     char *command;        /* Command string. */
  979.     char *words;        /* Description of which words to extract
  980.                  * from the command.  Either num[-num] or
  981.                  * a pattern. */
  982. {
  983.     char *result;
  984.     char *start, *end, *dst;
  985.     register char *next;
  986.     int first;            /* First word desired. -1 means last word
  987.                  * only. */
  988.     int last;            /* Last word desired.  -1 means use everything
  989.                  * up to the end. */
  990.     int index;            /* Index of current word. */
  991.     char *pattern;
  992.  
  993.     /*
  994.      * Figure out whether we're looking for a numerical range or for
  995.      * a pattern.
  996.      */
  997.  
  998.     pattern = NULL;
  999.     first = 0;
  1000.     last = -1;
  1001.     if (*words == '$') {
  1002.     if (words[1] != '\0') {
  1003.         goto error;
  1004.     }
  1005.     first = -1;
  1006.     } else if (isdigit(*words)) {
  1007.     first = strtoul(words, &start, 0);
  1008.     if (*start == 0) {
  1009.         last = first;
  1010.     } else if (*start == '-') {
  1011.         start++;
  1012.         if (*start == '$') {
  1013.         start++;
  1014.         } else if (isdigit(*start)) {
  1015.         last = strtoul(start, &start, 0);
  1016.         } else {
  1017.         goto error;
  1018.         }
  1019.         if (*start != 0) {
  1020.         goto error;
  1021.         }
  1022.     }
  1023.     if ((first > last) && (last != -1)) {
  1024.         goto error;
  1025.     }
  1026.     } else {
  1027.     pattern = words;
  1028.     }
  1029.  
  1030.     /*
  1031.      * Scan through the words one at a time, copying those that are
  1032.      * relevant into the result string.  Allocate a result area large
  1033.      * enough to hold all the words if necessary.
  1034.      */
  1035.  
  1036.     result = (char *) ckalloc((unsigned) (strlen(command) + 1));
  1037.     dst = result;
  1038.     for (next = command; isspace(*next); next++) {
  1039.     /* Empty loop body:  just find start of first word. */
  1040.     }
  1041.     for (index = 0; *next != 0; index++) {
  1042.     start = next;
  1043.     end = TclWordEnd(next, 0);
  1044.     if (*end != 0) {
  1045.         end++;
  1046.         for (next = end; isspace(*next); next++) {
  1047.         /* Empty loop body:  just find start of next word. */
  1048.         }
  1049.     }
  1050.     if ((first > index) || ((first == -1) && (*next != 0))) {
  1051.         continue;
  1052.     }
  1053.     if ((last != -1) && (last < index)) {
  1054.         continue;
  1055.     }
  1056.     if (pattern != NULL) {
  1057.         int match;
  1058.         char savedChar = *end;
  1059.  
  1060.         *end = 0;
  1061.         match = Tcl_StringMatch(start, pattern);
  1062.         *end = savedChar;
  1063.         if (!match) {
  1064.         continue;
  1065.         }
  1066.     }
  1067.     if (dst != result) {
  1068.         *dst = ' ';
  1069.         dst++;
  1070.     }
  1071.     strncpy(dst, start, (end-start));
  1072.     dst += end-start;
  1073.     }
  1074.     *dst = 0;
  1075.  
  1076.     /*
  1077.      * Check for an out-of-range argument index.
  1078.      */
  1079.  
  1080.     if ((last >= index) || (first >= index)) {
  1081.     ckfree(result);
  1082.     Tcl_AppendResult((Tcl_Interp *) iPtr, "word selector \"", words,
  1083.         "\" specified non-existent words", (char *) NULL);
  1084.     return NULL;
  1085.     }
  1086.     return result;
  1087.  
  1088.     error:
  1089.     Tcl_AppendResult((Tcl_Interp *) iPtr, "bad word selector \"", words,
  1090.         "\":  should be num-num or pattern", (char *) NULL);
  1091.     return NULL;
  1092. }
  1093.